www.gusucode.com > 地方成人教育中心整站源代码 1 > 地方成人教育中心整站源代码 1.0/bbs/boke/Cls_Main.asp
<% 'Product DvBoke version 1.00 'Copyright (C) 2004,2005 AspSky.Net. All rights reserved. 'Written By Dvbbs.net Fssunwin 'Web: http://www.aspsky.net/ , http://www.dvbbs.net/ 'Email: eway@aspsky.net Sunwin@artbbs.net Class Cls_DvBoke Public UserID,UserName,UserIP,UserSex Public BokeUserID,BokeUserName,BokeName,BokeDOM,BokeNode,BokeSetting,BokeCat,BokeCatNode,BokeStype Public SystemDoc,System_Node,System_Setting,System_UpSetting,SysCat,SysChatCat Public SqlQueryNum,ArchiveLink,ModHtmlLinked,mArchiveLink Public Page_File,Skins_Path,Cache_Path,Page_Strings,Main_Strings Public Stats,ScriptName,RefreshID Public IsBokeOwner,IsMaster,InputShowMsg Private SystemPath,ErrCode,bokeurl_r Private Sub Class_Initialize() BokeStype = "文章,收藏,链接,交易,相册" BokeStype = Split(BokeStype,",") SqlQueryNum = 0 IsBokeOwner = False IsMaster = False If Dvbbs.Master Then IsMaster = True End If 'Skins_Path = "Boke/Skins/default/" Cache_Path = "Boke/CacheFile/" Dim Tmpstr Tmpstr = Request.ServerVariables("PATH_INFO") Tmpstr = Split(Tmpstr,"/") ScriptName = Lcase(Tmpstr(UBound(Tmpstr))) UserSex = 1 If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "?" ArchiveLink = Lcase(Request.ServerVariables("QUERY_STRING")) If ArchiveLink <> "" Then ArchiveLink = Split(ArchiveLink,".") If Instr(Lcase(ArchiveLink(0)),"show_")=0 Then BokeName = Replace(ArchiveLink(0),".html","") Else ReDim ArchiveLink(5) End If If Lcase(InStr(Request.ServerVariables("QUERY_STRING"),".html")) = 0 And Lcase(InStr(Request.ServerVariables("QUERY_STRING"),".xml")) = 0 Then BokeName = Request("User") Set MyBoardOnline=new Cls_UserOnlne Dvbbs.GetForum_Setting Dvbbs.CheckUserLogin If Request.QueryString("UserID")<>"" And IsNumeric(Request.QueryString("UserID")) Then BokeUserID = cCur(Request.QueryString("UserID")) UserID = Dvbbs.UserID UserName = "" ElseIf Dvbbs.UserID>0 Then UserID = Dvbbs.UserID BokeUserID = Dvbbs.UserID UserName = Dvbbs.MemberName UserSex = Dvbbs.UserSession.documentElement.selectSingleNode("userinfo/@usersex").text Else BokeUserID = 0 UserID = 0 UserName = "" End If If Instr(Lcase(ArchiveLink(0)),"userid_") and IsNumeric(Replace(Lcase(ArchiveLink(0)),"userid_","")) Then BokeUserID = cCur(Replace(Lcase(ArchiveLink(0)),"userid_","")) BokeName = "" End If UserIP = Dvbbs.UserTrueIP LoadSetup(0) Skins_Path = System_Node.getAttribute("s_path") GetUBokeInfo() If Not IsObject(BokeNode) Then Setup_SysBokeNode End If End Sub Private Sub class_terminate() Set SystemDoc = Nothing If IsObject(BokeDOM) Then Set BokeDOM = Nothing If IsObject(Boke_Conn) Then Boke_Conn.Close : Set Boke_Conn = Nothing End Sub Public Property Get Version() Version = "<a href=""http://www.cndw.com"" target=""_blank""><u>iBoker V1.0.0</u></a>" End Property Public Function Execute(Command) 'Response.Write Command 'Response.Write "<br/>" If Dv_Boke_InDvbbsData = 1 Then If Not IsObject(Boke_Conn) Then Boke_ConnectionDatabase() Set Execute = Boke_Conn.Execute(Command) Else If Not IsObject(Conn) Then ConnectionDatabase() Set Execute = Conn.Execute(Command) End If SqlQueryNum = SqlQueryNum + 1 End Function Rem 判断发言是否来自外部 Public Function ChkPost() Dim server_v1,server_v2 Chkpost=False server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) If Mid(server_v1,8,len(server_v2))=server_v2 Then Chkpost=True End Function Public Function CheckNumeric(Byval CHECK_ID) If CHECK_ID<>"" and IsNumeric(CHECK_ID) Then _ CHECK_ID = cCur(CHECK_ID) _ Else _ CHECK_ID = 0 CheckNumeric = CHECK_ID End Function Public Function Checkstr(Str) If Isnull(Str) Then CheckStr = "" Exit Function End If Str = Replace(Str,Chr(0),"") CheckStr = Replace(Str,"'","''") End Function Public Function getUrlEncodel(byVal Url) Dim i,code getUrlEncodel="" If Trim(Url)="" Then Exit Function For i=1 To Len(Url) code=Asc(Mid(Url,i,1)) If code<0 Then code = code + 65536 If code>255 Then getUrlEncodel=getUrlEncodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2) Else getUrlEncodel=getUrlEncodel&Mid(Url,i,1) End If Next End Function Public Function Furl(url) Furl=Replace(url," ","%20",1,-1,1) Furl=getUrlEncodel(Furl) End Function Function HTMLEncode(reString) '转换HTML代码 Dim Str:Str=reString IF Not isnull(Str) Then Str = replace(Str, ">", ">") Str = replace(Str, "<", "<") Str = Replace(Str, CHR(32), " ") Str = Replace(Str, CHR(9), " ") Str = Replace(Str, CHR(9), "    ") Str = Replace(Str, CHR(34), """) Str = Replace(Str, CHR(39), "'") Str = Replace(Str, CHR(13), "") Str = Replace(Str, CHR(10), "<br>") HTMLEncode = Str End IF End Function Function ClearHtmlTages(reString) Dim Re Dim Str:Str=reString IF Not isnull(Str) Then Set Re=New RegExp Re.IgnoreCase =True Re.Global=True Re.Pattern="<(.[^>]*)>" Str=Re.Replace(Str, "") Set Re=Nothing Str = replace(Str, ">", ">") Str = replace(Str, "<", "<") Str = Replace(Str, CHR(32), " ") Str = Replace(Str, CHR(9), " ") Str = Replace(Str, CHR(9), "    ") Str = Replace(Str, CHR(34), """) Str = Replace(Str, CHR(39), "'") Str = Replace(Str, CHR(13), "") 'Str = Server.Htmlencode(Str) End IF ClearHtmlTages = Str End Function '初始化默认数据 Private Sub Setup_SysBokeNode() Dim XslDoc Page_File = Server.MapPath(Cache_Path &"default.config") Set XslDoc=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") If Not XslDoc.Load(Page_File) Then Response.Write "初始数据不存在!" Response.End Else Set BokeNode=XslDoc.documentElement.selectSingleNode("rs:data/z:row") BokeNode.attributes.getNamedItem("joinboketime").text = Now() BokeNode.attributes.getNamedItem("lastuptime").text = Now() BokeSetting = Split(BokeNode.getAttribute("bokesetting"),",") Set BokeCat=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") BokeCat.Load(Server.MapPath(Cache_Path &"usercat.config")) End If Set XslDoc = Nothing End Sub 'UserID=0 ,UserName=1 ,NickName=2 ,BokeName=3 ,PassWord=4 ,BokeTitle=5 ,BokeChildTitle=6 ,BokeNote=7 ,JoinBokeTime=8 ,PageView=9 ,TopicNum=10 ,FavNum=11 ,PhotoNum=12 ,PostNum=13 ,TodayNum=14 ,Trackbacks=15 ,SpaceSize=16 ,XmlData=17 ,SysCatID=18 ,BokeSetting=19 ,LastUpTime=20 ,SkinID=21,Stats=22 Public Sub GetUBokeInfo() Dim Sql,Rs Sql = "Select UserID,UserName,NickName,BokeName,PassWord,BokeTitle,BokeChildTitle,BokeNote,JoinBokeTime,PageView,TopicNum,FavNum,PhotoNum,PostNum,TodayNum,Trackbacks,SpaceSize,XmlData,SysCatID,BokeSetting,LastUpTime,SkinID,Stats,S.S_SkinName,S.S_Path,S.S_ViewPic,S.S_Info,S.S_Builder From [Dv_Boke_User] U Inner Join [Dv_Boke_Skins] S On U.SkinID = S.S_ID" Sql = Lcase(Sql) If BokeName<>"" Then Sql = Sql & " where BokeName = '"&Dvbbs.Checkstr(BokeName)&"'" ElseIf BokeUserID>0 Then Sql = Sql & " where UserID = "&BokeUserID Else '请选取相关的DVBOKE,返回综合列表 Exit Sub End If Set Rs = Execute(SQL) If Rs.EOF And Rs.BOF Then '申请页面 BokeUserID = 0 If Dvbbs.UserID = 0 Then 'Response.Write "<script>alert(""您访问的博客用户不存在,系统将会自动转向到系统博客首页面!"");</script>" 'Response.Redirect "BokeIndex.asp" Else 'Response.Write "<script>alert(""您访问的博客用户不存在,系统将会自动转向到个人博客申请页面!"");</script>" 'Response.Redirect "BokeApply.asp" End If Exit Sub End If BokeUserID = Rs(0) BokeUserName = Rs(2) BokeName = Rs(3) BokeSetting = Split(Rs(19)&"",",") If BokeUserID = UserID and UserID>0 Then IsBokeOwner = True End If If Not IsMaster Then If Rs(22)=2 Then ShowCode(52) ShowMsg(0) ElseIf Rs(22)=1 and Not IsBokeOwner Then ShowCode(53) ShowMsg(0) End If If BokeSetting(0) <> "1" And Not IsBokeOwner Then ShowCode(41) ShowMsg(0) End If End If Set BokeDOM=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") Rs.Save BokeDOM,1 BokeDOM.documentElement.RemoveChild(BokeDOM.documentElement.selectSingleNode("s:Schema")) Set BokeNode=BokeDOM.documentElement.selectSingleNode("rs:data/z:row") If DateDiff("d",Rs(20),now())<>0 and BokeNode.getAttribute("todaynum")>0 Then BokeNode.attributes.getNamedItem("todaynum").text = 0 Execute("Update [Dv_Boke_User] set TodayNum=0 where UserID="&BokeUserID) End If BokeNode.attributes.getNamedItem("lastuptime").text = Rs(20) BokeNode.attributes.getNamedItem("joinboketime").text = Rs(8) 'If ScriptName<>"bokeindex.asp" Then Skins_Path = BokeNode.getAttribute("s_path") 'End If Set BokeCat=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") If Rs(16)="" Or IsNull(Rs(17)) Then BokeCat.Load(Server.MapPath(Cache_Path &"usercat.config")) Else If Not BokeCat.LoadXml(Rs(17)) Then 'Response.Write "用户栏目数据出错!" BokeCat.Load(Server.MapPath(Cache_Path &"usercat.config")) End If End If 'Response.Write BokeCat.documentElement.xml Set BokeCatNode = BokeCat.documentElement.selectNodes("rs:data/z:row") Rs.Close : Set Rs = Nothing End Sub '重置系统表数据 ACT=1强制更新 Public Sub LoadSetup(Act) Page_File = Server.MapPath(Cache_Path &"System.config") Set SystemDoc = Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") If Not SystemDoc.Load(Page_File) Then SystemDoc.LoadXml("<?xml version=""1.0"" encoding=""Gb2312""?><bokesystem/>") ReLoadBoke_System() ReLoadBoke_SysCat() SaveSystemCache() ElseIf Act=1 Then ReLoadBoke_System() ReLoadBoke_SysCat() SaveSystemCache() End If Set System_Node = SystemDoc.documentElement.selectSingleNode("/bokesystem/system/rs:data/z:row") Set SysCat = SystemDoc.documentElement.selectSingleNode("/bokesystem/syscat") Set SysChatCat = SystemDoc.documentElement.selectSingleNode("/bokesystem/syschatcat") System_Setting = Split(System_Node.getAttribute("s_setting"),",") System_UpSetting = Split(System_Setting(12),"|") 'Response.Write SystemDoc.documentElement.xml End Sub Public Sub SaveSystemCache() Page_File = Server.MapPath(Cache_Path &"System.config") SystemDoc.save Page_File End Sub '系统 'S_LastPostTime,S_TopicNum,S_PhotoNum,S_FavNum,S_UserNum,S_TodayNum,S_PostNum Public Sub Update_System(UserNum,TodayNum,FavNum,PhotoNum,TopicNum,PostNum,LastTime) If Not IsNull(LastTime) and IsDate(LastTime) Then System_Node.attributes.getNamedItem("s_lastposttime").text = LastTime End If System_Node.attributes.getNamedItem("s_topicnum").text = System_Node.attributes.getNamedItem("s_topicnum").text + TopicNum System_Node.attributes.getNamedItem("s_photonum").text = System_Node.attributes.getNamedItem("s_photonum").text + PhotoNum System_Node.attributes.getNamedItem("s_favnum").text = System_Node.attributes.getNamedItem("s_favnum").text + FavNum System_Node.attributes.getNamedItem("s_usernum").text = System_Node.attributes.getNamedItem("s_usernum").text + UserNum System_Node.attributes.getNamedItem("s_todaynum").text = System_Node.attributes.getNamedItem("s_todaynum").text + TodayNum System_Node.attributes.getNamedItem("s_postnum").text = System_Node.attributes.getNamedItem("s_postnum").text + PostNum 'SaveSystemCache() End Sub '系统分类 'sCatID,uCatNum,TopicNum,PostNum,TodayNum,LastUpTime Public Sub Update_SysCat(sCatID,UserNum,TodayNum,TopicNum,PostNum,LastTime) Dim UpCatID,i,Nodes UpCatID = Split(sCatID,",") For i = 0 To Ubound(UpCatID) Set Nodes = SystemDoc.documentElement.selectSingleNode("//rs:data/z:row[@scatid = '"&UpCatID(i)&"']") If Not (Nodes is nothing) Then If Not IsNull(LastTime) and IsDate(LastTime) Then Nodes.attributes.getNamedItem("lastuptime").text = LastTime End If Nodes.attributes.getNamedItem("ucatnum").text = Nodes.attributes.getNamedItem("ucatnum").text + UserNum Nodes.attributes.getNamedItem("topicnum").text = Nodes.attributes.getNamedItem("topicnum").text + TopicNum Nodes.attributes.getNamedItem("postnum").text = Nodes.attributes.getNamedItem("postnum").text + PostNum Nodes.attributes.getNamedItem("todaynum").text = Nodes.attributes.getNamedItem("todaynum").text + TodayNum End If Next 'SaveSystemCache() End Sub Private Sub ReLoadBoke_System() Dim Nodes,NodeList Set Nodes = SystemDoc.documentElement.selectSingleNode("/bokesystem/system") If Nodes is Nothing Then Set Nodes = SystemDoc.createNode(1,"system","") SystemDoc.documentElement.appendChild(Nodes) Else If Nodes.hasChildNodes Then Nodes.removeChild Nodes.selectSingleNode("rs:data") End If End If Dim Rs,TempXmlDoc,TempNodes Set TempXmlDoc = Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") Set Rs = Execute(Lcase("Select Top 1 B.S_Name,S_Note,S_LastPostTime,S_TopicNum,S_PhotoNum,S_FavNum,S_UserNum,S_TodayNum,S_PostNum,S_Setting,S_Url,S_sDomain,SkinID,S.S_SkinName,S.S_Path,S.S_ViewPic,S.S_Info,S.S_Builder From Dv_Boke_System B Inner Join [Dv_Boke_Skins] S On S.S_ID = B.SkinID")) Rs.Save TempXmlDoc,1 TempXmlDoc.documentElement.RemoveChild(TempXmlDoc.documentElement.selectSingleNode("s:Schema")) Set TempNodes = TempXmlDoc.documentElement.selectSingleNode("rs:data/z:row") TempNodes.attributes.getNamedItem("s_lastposttime").text = Rs("S_LastPostTime") If (DateDiff("d",Rs("S_LastPostTime"),now())<>0 and TempNodes.getAttribute("s_todaynum")>0) or TempNodes.getAttribute("s_todaynum")<0 Then TempNodes.attributes.getNamedItem("s_todaynum").text = 0 Execute("Update [Dv_Boke_System] set S_TodayNum=0") End If Set TempNodes=TempXmlDoc.documentElement.selectSingleNode("rs:data") Nodes.appendChild(TempNodes) Rs.Close Set Rs = Nothing End Sub 'SysCat,SysChatCat Private Sub ReLoadBoke_SysCat() Dim Nodes,TempNodes,NodeList,TempXmlDoc Dim Rs Set TempXmlDoc = Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") 'SysCat Set Nodes = SystemDoc.documentElement.selectSingleNode("/bokesystem/syscat") If Nodes is Nothing Then Set Nodes = SystemDoc.createNode(1,"syscat","") SystemDoc.documentElement.appendChild(Nodes) Else If Nodes.hasChildNodes Then Nodes.removeChild Nodes.selectSingleNode("rs:data") End If End If Set Rs = Execute(Lcase("Select sCatID,sCatTitle,sCatNote,uCatNum,TopicNum,PostNum,TodayNum,sType,LastUpTime From Dv_Boke_SysCat where sType = 0")) If Not Rs.Eof Then Rs.Save TempXmlDoc,1 TempXmlDoc.documentElement.RemoveChild(TempXmlDoc.documentElement.selectSingleNode("s:Schema")) Set TempNodes = TempXmlDoc.documentElement.selectNodes("rs:data/z:row") For Each NodeList in TempNodes NodeList.attributes.getNamedItem("lastuptime").text = Rs("LastUpTime") If (DateDiff("d",Rs("LastUpTime"),now())<>0 and NodeList.getAttribute("TodayNum")>0) or NodeList.getAttribute("TodayNum")<0 Then NodeList.attributes.getNamedItem("todaynum").text = 0 Execute("Update [Dv_Boke_SysCat] set todaynum=0 where sCatID="&Rs(0)) End If Rs.MoveNext Next Set TempNodes=TempXmlDoc.documentElement.selectSingleNode("rs:data") Nodes.appendChild(TempNodes) End If 'SysChatCat Set Nodes = SystemDoc.documentElement.selectSingleNode("/bokesystem/syschatcat") If Nodes is Nothing Then Set Nodes = SystemDoc.createNode(1,"syschatcat","") SystemDoc.documentElement.appendChild(Nodes) Else If Nodes.hasChildNodes Then Nodes.removeChild Nodes.selectSingleNode("rs:data") End If End If Set Rs = Execute(Lcase("Select sCatID,sCatTitle,sCatNote,uCatNum,TopicNum,PostNum,TodayNum,sType,LastUpTime From Dv_Boke_SysCat where sType = 1")) If Not Rs.Eof Then Rs.Save TempXmlDoc,1 TempXmlDoc.documentElement.RemoveChild(TempXmlDoc.documentElement.selectSingleNode("s:Schema")) Set TempNodes =TempXmlDoc.documentElement.selectNodes("rs:data/z:row") For Each NodeList in TempNodes NodeList.attributes.getNamedItem("lastuptime").text = Rs("LastUpTime") If (DateDiff("d",Rs("LastUpTime"),now())<>0 and NodeList.getAttribute("TodayNum"))>0 or NodeList.getAttribute("TodayNum")<0 Then NodeList.attributes.getNamedItem("todaynum").text = 0 Execute("Update [Dv_Boke_SysCat] set todaynum=0 where sCatID="&Rs(0)) End If Rs.MoveNext Next Set TempNodes=TempXmlDoc.documentElement.selectSingleNode("rs:data") Nodes.appendChild(TempNodes) End If Rs.Close Set Rs = Nothing Set TempXmlDoc = Nothing End Sub '应用过程 '页面加载 Public Sub LoadPage(ByVal StyleFile) Dim XslDoc Page_File = Server.MapPath(Skins_Path & "xml/" & StyleFile) Set XslDoc=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") If Not XslDoc.Load(Page_File) Then Response.Write "模板不存在" Response.End Exit Sub Else Set Page_Strings = XslDoc.DocumentElement.selectNodes("xsl:variable") End If Set XslDoc = Nothing End Sub Public Sub Head(isSystem) Page_File = Server.MapPath(Skins_Path & "xml/main.xslt") If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "boke.asp?" mArchiveLink = "bokeindex.asp?" bokeurl_r = "bokerss.asp?" End If Dim XslDoc Set XslDoc=Dvbbs.CreateXmlDoc("Msxml2.FreeThreadedDOMDocument") If Not XslDoc.Load(Page_File) Then Response.Write "主模板不存在!" Exit Sub Else Set Main_Strings = XslDoc.DocumentElement.selectNodes("xsl:variable") End If Set XslDoc = Nothing Dim Html Html = Main_Strings(0).text If isSystem = 1 Then Html = Replace(Html,"{$boketitle}",System_Node.getAttribute("s_name")) Html = Replace(Html,"{$bokechildtitle}",System_Setting(17)) Html = Replace(Html,"{$bokename}","") Html = Replace(Html,"{$BokeUrl}",System_Node.getAttribute("s_url")) Else Html = Replace(Html,"{$boketitle}",BokeNode.getAttribute("boketitle")&"") Html = Replace(Html,"{$bokechildtitle}",BokeNode.getAttribute("bokechildtitle")&"") Html = Replace(Html,"{$bokename}",BokeNode.getAttribute("bokename")&"--") Html = Replace(Html,"{$BokeUrl}",System_Node.getAttribute("s_url")&ModHtmlLinked&BokeNode.getAttribute("bokename")&".html") End If Html = Replace(Html,"{$stats}",Stats) Html = Replace(Html,"{$copyright}","") Html = Replace(Html,"{$skinpath}",Skins_Path) If BokeUserID > 0 Then Html = Replace(Html,"{$rssurl}",Dvbbs.Get_ScriptNameUrl & bokeurl_r & BokeName & ".rss.xml") Else Html = Replace(Html,"{$rssurl}","") End If Response.Write Html End Sub Public Sub Nav(isSystem) Top(isSystem) Dim Html If isSystem = 1 Then Html = Main_Strings(33).text Else Html = Main_Strings(3).text Html = Replace(Html,"{$TopicNum}",BokeNode.getAttribute("topicnum")&"") Html = Replace(Html,"{$FavNum}",BokeNode.getAttribute("favnum")&"") Html = Replace(Html,"{$TodayNum}",BokeNode.getAttribute("todaynum")&"") Html = Replace(Html,"{$LastUpTime}",FormatDateTime(CDate(BokeNode.getAttribute("lastuptime")),1)) If BokeSetting(14)="1" Then If BokeSetting(15)<>"1" And BokeSetting(15)<>"" Then Main_Strings(30).text = Replace(Main_Strings(30).text,"{$PaytoStr}",BokeSetting(15)) Html = Replace(Html,"{$BokePayto}",Main_Strings(30).text) Else Main_Strings(30).text = Replace(Main_Strings(30).text,"{$PaytoStr}",Main_Strings(31).text) Html = Replace(Html,"{$BokePayto}",Main_Strings(30).text) End If Else Html = Replace(Html,"{$BokePayto}","") End If If IsMaster Then If BokeNode.getAttribute("stats")="0" Then Html = Replace(Html,"{$Open}",Main_Strings(36).text) Else Html = Replace(Html,"{$Open}",Main_Strings(37).text) End If Else Html = Replace(Html,"{$Open}","") End If End If If IsBokeOwner Then If isSystem = 1 Then Html = Replace(Html,"{$BokeOwnerNav}",Main_Strings(34).text) Else Html = Replace(Html,"{$BokeOwnerNav}",Main_Strings(27).text) End If Else Html = Replace(Html,"{$BokeOwnerNav}",Main_Strings(28).text) End If Html = Replace(Html,"{$bokeurl}",ModHtmlLinked) Html = Replace(Html,"{$ibokeurl}",mArchiveLink) Html = Replace(Html,"{$bokename}",BokeName) Html = Replace(Html,"{$skinpath}",Skins_Path) Response.Write Html If isSystem = 0 Then BokeChannel() End Sub Public Sub Top(isSystem) Head(isSystem) Dim Html Html = Main_Strings(2).text If isSystem = 1 Then Html = Replace(Html,"{$boketitle}",System_Node.getAttribute("s_name")) Html = Replace(Html,"{$bokechildtitle}",System_Setting(17)) Html = Replace(Html,"{$SiteUrl}","") Else If System_Node.getAttribute("s_sdomain") = "" Then Html = Replace(Html,"{$SiteUrl}","") Else Dim sDomain,i,sDomainList sDomain = Split(System_Node.getAttribute("s_sdomain")&"","|") For i = 0 To Ubound(sDomain) If sDomainList = "" Then sDomainList = "<a href=""http://"&BokeName&"."&sDomain(i)&"/"">"&BokeName&"."&sDomain(i)&"</a>" Else sDomainList = sDomainList & " , <a href=""http://"&BokeName&"."&sDomain(i)&"/"">"&BokeName&"."&sDomain(i)&"</a>" End if Next Html = Replace(Html,"{$SiteUrl}",Replace(Main_Strings(35).text,"{$SiteUrl}",sDomainList)) End If Html = Replace(Html,"{$boketitle}",BokeNode.getAttribute("boketitle")&"") Html = Replace(Html,"{$bokechildtitle}",BokeNode.getAttribute("bokechildtitle")&"") End If Response.Write Html End Sub Public Sub BokeChannel() Dim TempList,Temp Dim Html,Node,i,NodeList If Is_Isapi_Rewrite = 0 Then ModHtmlLinked = "boke.asp?" For i = 0 To 4 Set NodeList = BokeCat.documentElement.selectNodes("rs:data/z:row[@utype='"&i&"']") If NodeList.length>0 Then Temp = "" Html = Main_Strings(16).text For Each Node in NodeList TempList = Main_Strings(17).text TempList = Replace(TempList,"{$channelname}",Node.getAttribute("ucattitle")) TempList = Replace(TempList,"{$cat_id}",Node.getAttribute("ucatid")) Temp = Temp & TempList Next Html = Replace(Html,"{$channellist}",Temp) Html = Replace(Html,"{$bokename}",BokeName) Html = Replace(Html,"{$cat_tid}",i) Html = Replace(Html,"{$bokeurl}",ModHtmlLinked) Response.Write Html End If Next End Sub Public Sub BokeChannelToJS() Dim Temp,Temp1,Temp2 Dim Html,Node,i,ii,NodeList Response.Write "<script language=""JavaScript"">var BokeCat_ID = new Array();var BokeCat_Title = new Array();" For i = 0 To 4 Response.Write "" Temp1 = "[" Temp2 = "[" ii=0 Set NodeList = BokeCat.documentElement.selectNodes("rs:data/z:row[@utype='"&i&"']") If NodeList.length>0 Then For Each Node in NodeList ii = ii + 1 Temp1 = Temp1 & "'" & Node.getAttribute("ucatid")&"'" Temp2 = Temp2 & "'" &Node.getAttribute("ucattitle") &"'" If ii<NodeList.length Then Temp1 = Temp1 & "," Temp2 = Temp2 & "," End If Next End If Temp1 = Temp1 & "]" Temp2 = Temp2 & "]" Response.Write "BokeCat_ID["&i&"]="&Temp1&";"&vBnewline Response.Write "BokeCat_Title["&i&"]="&Temp2&";"&vBnewline Next Response.Write "</script>" End Sub '------------------------------------- Left Function ------------------------------------------------------------ Public Sub LeftMenu() Dim Html,i,Str1 Html = Main_Strings(4).text For i=7 To 15 Str1 = "{$"&Main_Strings(i).getAttribute("title")&"}" If Instr(Html,Str1) Then Select Case Str1 Case "{$show_bokenote}" Html = Replace(Html,"{$show_bokenote}",SBokeNote) Case "{$show_channel}" Html = Replace(Html,Str1,SChannel) Case Else Html = Replace(Html,Str1,Main_Strings(i).text) End Select End If Next If Instr(Html,"{$bokelinks}") Then Html = Replace(Html,"{$bokelinks}",LinkStr) End If If Instr(Html,"{$bokephotos}") Then Html = Replace(Html,"{$bokephotos}",BokePhotos) End If If Instr(Html,"{$boketopicnews}") Then Html = Replace(Html,"{$boketopicnews}",BokePost) End If If Instr(Html,"{$bokecounts}") Then Html = Replace(Html,"{$bokecounts}",BokeCounts) End If If BokeSetting(15)<>"1" And BokeSetting(15)<>"" Then Html = Replace(Html,"{$ChannelPay}",BokeSetting(15)) Else Html = Replace(Html,"{$ChannelPay}","") End If Html = Replace(Html,"{$bokename}",BokeName) Html = Replace(Html,"{$bokeurl_r}",Dvbbs.Get_ScriptNameUrl & bokeurl_r) Html = Replace(Html,"{$bokeurl}",ModHtmlLinked) Response.Write Html End Sub Public Function BokeCounts() Dim ShowTemp ShowTemp = Main_Strings(26).text ShowTemp = Replace(ShowTemp,"{$TodayNum}",BokeNode.getAttribute("todaynum")) ShowTemp = Replace(ShowTemp,"{$TopicNum}",BokeNode.getAttribute("topicnum")) ShowTemp = Replace(ShowTemp,"{$FavNum}",BokeNode.getAttribute("favnum")) ShowTemp = Replace(ShowTemp,"{$PhotoNum}",BokeNode.getAttribute("photonum")) ShowTemp = Replace(ShowTemp,"{$PostNum}",BokeNode.getAttribute("postnum")) ShowTemp = Replace(ShowTemp,"{$Trackbacks}",BokeNode.getAttribute("trackbacks")) ShowTemp = Replace(ShowTemp,"{$JoinBokeTime}",Formatdatetime(BokeNode.getAttribute("joinboketime"),2)) ShowTemp = Replace(ShowTemp,"{$LastUpTime}",Formatdatetime(BokeNode.getAttribute("lastuptime"),2)) BokeCounts = ShowTemp End Function Public Function SBokeNote() Dim ShowTemp ShowTemp = "" If BokeNode.getAttribute("bokenote")<>"" Then ShowTemp = Main_Strings(7).text ShowTemp = Replace(ShowTemp,"{$bokenote}",HtmlEncode(BokeNode.getAttribute("bokenote"))) End If SBokeNote = ShowTemp End Function Public Function SChannel() Dim ShowTemp If BokeNode.getAttribute("xmldata")<>"" Then ShowTemp = Main_Strings(8).text ShowTemp = Replace(ShowTemp,"{$bokechannel}","") End If SChannel = ShowTemp End Function Public Function ChannelTitle(Ucatid) Dim Channels Set Channels = BokeCat.selectSingleNode("//rs:data/z:row[@ucatid='"&Ucatid&"']") If Channels Is Nothing Then ChannelTitle = "" Else ChannelTitle = Channels.getAttribute("ucattitle") End If End Function Public Function LinkStr() Dim Node,ChildNodes,LinkTemp,Temp Set Node = DvBoke.BokeCat.selectNodes("xml/bokelink/rs:data/z:row") If Node.Length=0 Then LinkStr = "暂未添加该信息。" Exit Function End If For Each ChildNodes in Node Temp = Main_Strings(23).text Temp = Replace(Temp,"{$linkurl}",ClearHtmlTages(ChildNodes.getAttribute("content"))) Temp = Replace(Temp,"{$linkname}",ClearHtmlTages(ChildNodes.getAttribute("title"))) LinkTemp = LinkTemp & Temp Next LinkStr = LinkTemp End Function Public Function BokePost() Dim Node,ChildNodes,BokePostTemp,Temp Set Node = DvBoke.BokeCat.selectNodes("xml/bokepost/rs:data/z:row") If Node.Length=0 Then BokePost = "暂未添加该信息。" Exit Function End If Dim Title For Each ChildNodes in Node Temp = Main_Strings(25).text Title = ChildNodes.getAttribute("title") If Title = "" Then Title = ChildNodes.getAttribute("content") End If Title = ClearHtmlTages(Title) If Len(Title)>16 Then Title = Left(Title,16)&"..." End If Temp = Replace(Temp,"{$title}", Title) Temp= Replace(Temp,"{$TopicID}",ChildNodes.getAttribute("rootid")) Temp= Replace(Temp,"{$PostID}",ChildNodes.getAttribute("postid")) Temp= Replace(Temp,"{$postusername}",ChildNodes.getAttribute("username")) BokePostTemp = BokePostTemp & Temp Next BokePostTemp = Replace(BokePostTemp,"{$bokename}",BokeName) BokePost = BokePostTemp End Function Public Function BokePhotos() Dim Node,ChildNodes,PhotosTemp,Temp Set Node = DvBoke.BokeCat.selectNodes("xml/bokephoto/rs:data/z:row") If Node.Length=0 Then BokePhotos = "暂未添加该信息。" Exit Function End If Dim ViewFile For Each ChildNodes in Node Temp = Main_Strings(24).text ViewFile = ChildNodes.getAttribute("previewimage") If ViewFile="" or IsNull(ViewFile) Then ViewFile = DvBoke.System_UpSetting(19) & ChildNodes.getAttribute("filename") End If Temp = Replace(Temp,"{$ViewPhoto}",ViewFile) Temp = Replace(Temp,"{$topic}",HTMLEncode(ChildNodes.getAttribute("title"))) Temp= Replace(Temp,"{$TopicID}",ChildNodes.getAttribute("topicid")) PhotosTemp = PhotosTemp & Temp Exit For Next PhotosTemp = Replace(PhotosTemp,"{$width}",Dvboke.System_UpSetting(14)) PhotosTemp = Replace(PhotosTemp,"{$height}",Dvboke.System_UpSetting(15)) PhotosTemp = Replace(PhotosTemp,"{$bokename}",BokeName) BokePhotos = PhotosTemp End Function '------------------------------------- Left Function ------------------------------------------------------------ Public Function SysInfo Dim TempStr Dim Endtime Endtime = Timer() TempStr = "查询次数:("& SqlQueryNum + Dvbbs.SqlQueryNum &")" TempStr = TempStr & ",页面执行时间 0"&FormatNumber((Endtime-Startime),5)&" 秒" SysInfo = TempStr End Function Public Sub Footer() Dim Html Html = Main_Strings(1).text If BokeUserName = "" or ScriptName="bokeindex.asp" Then BokeUserName = "<a href="""&System_Node.getAttribute("s_url")&""">"&System_Node.getAttribute("s_name")&"</a>" End If Html = Replace(Html,"{$bokeuser}",BokeUserName) Html = Replace(Html,"{$version}",Version) Html = Replace(Html,"{$sysinfo}",SysInfo) Response.Write Html End Sub Public Sub ShowCode(Byval Code) If ErrCode<>"" Then ErrCode = ErrCode & "," ErrCode = ErrCode & Code End Sub 'Stype 0=显示底部及顶部信息,1=不显示顶部及底部,2=在相关页面内显示 Public Sub ShowMsg(Stype) If sType = 2 Then If ErrCode = "" Then Exit Sub LoadPage("SysDescription.xslt") Dim Codes,ShowCodes,i,Description,Count Dim ShowSkins,TempStr ShowSkins = Page_Strings(0).text Count = Page_Strings.length Description = "" TempStr = Page_Strings(1).text Codes = ErrCode ShowCodes = Split(Codes,",") For i=0 to UBound(ShowCodes) If IsNumeric(ShowCodes(i)) Then If Clng(ShowCodes(i)) <= Count and Clng(ShowCodes(i))>1 Then Description = Description & Replace(TempStr,"{$msg}",Page_Strings(ShowCodes(i)).text) End If Else Description = Description & Replace(TempStr,"{$msg}",Server.Htmlencode(ShowCodes(i))) End If Next ShowSkins = Replace(ShowSkins,"{$refresh}","") ShowSkins = Replace(ShowSkins,"{$refreshinfro}","") ShowSkins = Replace(ShowSkins,"{$description}",Description) InputShowMsg = ShowSkins Else If ErrCode<>"" and ScriptName<>"bokedescription.asp" Then Response.Redirect Furl("BokeDescription.asp?user="&BokeName&"&ShowHead="& Stype &"&RefreshID="&RefreshID&"&Codes=" & ErrCode) End If End Sub '是否支持FSO Public Function SysObjFso() Dim xTestObj SysObjFso = False On Error Resume Next Set xTestObj = Dvbbs.iCreateObject("Scripting.FileSystemObject") If Err = 0 Then SysObjFso = True Set xTestObj = Nothing Err = 0 End Function Public Sub SysDeleteFile(PostID) If PostID = "" Or Not IsNumeric(PostID) Then Exit Sub Dim Rs Dim objFSO,FilePath,ViewFilepath,FileSize FileSize = 0 'On Error Resume Next Set objFSO = Dvbbs.iCreateObject("Scripting.FileSystemObject") FilePath = DvBoke.System_UpSetting(19) Set Rs=Execute("Select ID,FileName,PreviewImage,FileSize,BokeUserID From Dv_Boke_Upfile Where PostID = " & PostID) Do While Not Rs.Eof '删除附件 FileSize = Rs("FileSize") If SysObjFso=True Then If objFSO.FileExists(Server.MapPath(FilePath & Rs("FileName"))) Then objFSO.DeleteFile(Server.MapPath(FilePath & Rs("FileName"))) End If ViewFilepath = Rs("PreviewImage") IF Not IsNull(ViewFilepath) And ViewFilepath<>"" Then ViewFilepath=Replace(ViewFilepath,"..","") If objFSO.FileExists(Server.MapPath(ViewFilepath)) Then objFSO.DeleteFile(Server.MapPath(ViewFilepath)) End If End IF End If '返还文件空间 If FileSize>0 Then FileSize = Formatnumber((FileSize/1024)/1024,2) Response.Write "Update Dv_Boke_User Set SpaceSize = SpaceSize + "&FileSize&" where SpaceSize<>-1 and UserID="&Rs("BokeUserID") Execute("Update Dv_Boke_User Set SpaceSize = SpaceSize + "&FileSize&" where SpaceSize<>-1 and UserID="&Rs("BokeUserID")) End If '删除附件表记录 Execute("Delete From Dv_Boke_Upfile Where ID = " & Rs("ID")) Rs.MoveNext Loop Rs.Close:Set Rs=Nothing End Sub End Class %>